home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / spaces.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  127 lines
  1. /******************************\
  2. ** Spaces v1.0 for Solitarexx **
  3. **    by Michal Szafranski    **
  4. \******************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Spaces v1.0"'
  8. win = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDCYCLE 1 6 '0|1|2|3|4|5' 2 'Reshuffles' 12
  11. ADDTEXT 4 24 tex 6
  12. ADDBUTTON 12 10 "Abort"
  13. ADDBUTTON 13 12 'Reshuffle'
  14. ADDTEXT 14 30 tex 6
  15. SELECTGUI 1
  16. SCREENSIZE 5 0 13 0
  17. DO i = 0 TO 51
  18.     NEWSTACK i 0 0 (i//13) (i%13)
  19.     stack.i = RESULT
  20. END
  21. NEWSTACK 52 0 1 0 4
  22. deck = RESULT
  23. NEWSTACK 53 0 1 12 4
  24. waste = RESULT
  25. ADDCARDS deck SHUFFLED
  26.  
  27. DO FOREVER
  28.     ACTION
  29.     PARSE VAR RESULT act rest
  30.     IF act = 1 THEN EXIT
  31.     IF act = 3 THEN CALL GAME
  32. END
  33.  
  34. GAME:
  35.     SETGADGET 14 STR tex
  36.     CLEANUP deck
  37.     SELECTGUI 4
  38.     GETGADGET 1
  39.     shuff = RESULT
  40.     fin. = 0
  41.     CALL DODECK
  42.     DO FOREVER
  43.         ACTION
  44.         PARSE VAR RESULT act stack sid card
  45.         SELECT
  46.         WHEN act = 1 THEN EXIT
  47.         WHEN act = 2 & sid < 54 & card > 0 THEN CALL DOMOVE
  48.         WHEN act = 3 & stack = 13 & shuff>0 THEN CALL DOSHUFFLE
  49.         WHEN act = 3 & stack = 12 THEN DO
  50.             SELECTGUI 1
  51.             RETURN
  52.         END
  53.         OTHERWISE ERRBEEP
  54.         END
  55.     END
  56. RETURN
  57. DODECK:
  58.     DO jj = 0 TO 3
  59.         DO ii = fin.jj TO 12
  60.             i = 13*jj+ii
  61.             CARDSELECT deck 1
  62.             PARSE VAR RESULT kol.i war.i .
  63.             mm = stack.i
  64.             IF war.i = 0 THEN DO
  65.                 mm = waste
  66.                 kol.i = -1
  67.             END
  68.             MOVECARDS deck mm REVERSE
  69.         END
  70.     END
  71. RETURN
  72. DOMOVE:
  73.     i = sid
  74.     l = (sid+51)//52
  75.     ok = 0
  76.     DO WHILE ok = 0 & i~= l
  77.         i = (i+1)//52
  78.         IF war.i = 0 THEN DO
  79.             pos = i//13
  80.             IF pos=0 & war.sid = 1 THEN ok = 1
  81.             ELSE IF pos>0 THEN DO
  82.                 ip = i-1
  83.                 IF war.sid - war.ip = 1 & kol.ip = kol.sid THEN ok = 1
  84.             END
  85.         END
  86.     END
  87.     IF ok=1 THEN DO
  88.         war.i = war.sid
  89.         kol.i = kol.sid
  90.         kol.sid = -1
  91.         war.sid = 0
  92.         MOVECARDS stack stack.i
  93.         CALL CHECK
  94.     END
  95.     ELSE ERRBEEP
  96. RETURN
  97. DOSHUFFLE:
  98.     shuff = shuff-1
  99.     DO jj = 0 TO 3
  100.         DO ii = fin.jj TO 12
  101.             i = 13*jj+ii
  102.             CARDSELECT stack.i 1
  103.             MOVECARDS stack.i deck REVERSE
  104.         END
  105.     END
  106.     CARDSELECT waste 4
  107.     MOVECARDS waste deck REVERSE
  108.     SHUFFLECARDS deck
  109.     CALL DODECK
  110.     CALL CHECK
  111. RETURN
  112. CHECK:
  113.     fin = 0
  114.     DO jj = 0 TO 3
  115.         p = 13*jj
  116.         ii = 0
  117.         i = p
  118.         DO WHILE kol.i=kol.p & war.i=ii+1
  119.             i = i+1
  120.             ii = ii+1
  121.         END
  122.         fin.jj = ii
  123.         fin = fin+fin.jj
  124.     END
  125.     IF fin = 48 THEN SETGADGET 14 STR win
  126. RETURN
  127.